home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / itsybit.exe / ITSYBITS.PAS < prev   
Pascal/Delphi Source File  |  1993-01-12  |  28KB  |  902 lines
  1. unit ItsyBits;
  2.  
  3. {
  4.   Unit:               ITSYBITS.PAS
  5.   Description:        Provides support for windows with small captions.
  6.   Version:            1.0
  7.   Creation Date:      January 7, 1993
  8.   Modification Date:  January 12, 1993
  9.   Operating System:   MS-DOS 3.x and Windows 3.1
  10.   Hardware Required:  Windows-capable computer system
  11.   Programming System: Borland Pascal for Windows 7.0
  12.   BPW Translation by: Craig Boyd
  13.   Original Author:    Charles E. Kindel, Jr. (9/27/91).
  14.  
  15.  
  16.   About This Unit
  17.  
  18.   This is a BPW translation of ITSYBITS.C, which can be found in
  19.   ITSBITS.ZIP in Lib 5 of the WINSDK forum on CompuServe.  Consult
  20.   ITSYBITS.DOC (included in ITSBITS.ZIP) for more information on using
  21.   ItsyBitsy windows.  Note that there is another version of ITSBITS.ZIP
  22.   in Lib 1 of WINSDK that has a later upload date.  I haven't looked at
  23.   it, so I don't know what, if anything, is different from the version
  24.   in Lib 5.  Note also that forum libraries can be rearranged at a
  25.   moment's notice, so please don't blame me if ITSBITS.ZIP turns up
  26.   missing!
  27.  
  28.   The only thing I've added to ITSYBITS.PAS that's not in ITSYBITS.C is
  29.   the TItsyBitsWindow object declaration, which let's you use ItsyBits
  30.   windows in OWL-based programs.  IBTEST.PAS is a sample program
  31.   showing how to use windows derived from TIstyBitsWindow.
  32.  
  33.   The following comments are from the original author:
  34.  
  35.     ItsyBitsy is a support module that allows you to create windows that
  36.     look and act very much like a popup window with a system menu and
  37.     caption bar, except everything is scaled to about 2/3 scale.
  38.  
  39.     For documentation on how to use ItsyBits, read the document
  40.     ITSYBITS.RTF, which is in rich text format.
  41.  
  42.     Little known fact:  ExtTextOut() is the fastest way to draw a filled
  43.     rectangle in Windows (if you don't want dithered colors or borders).
  44.  
  45.     Unfortunately there is a bug in the Windows 3.0 8514 driver in using
  46.     ExtTextOut() to a memory DC.  If you are drawing to an off screen
  47.     bitmap, then blitting that bitmap to the display, do not define
  48.     USE_EXTTEXTOUT below.
  49.  
  50.     The macro (DRAWFASTRECT) draws a filled rectangle with no border and a
  51.     solid color.  It uses the current background color as the fill color.
  52.  
  53.  
  54.   Update History
  55.  
  56.   update    ver   description (author)
  57.   -------   ---   -----------
  58.   9301.07   0.0   Work begun on translating C source code. (CSB)
  59.   9301.08   1.0   First working version. (CSB)
  60.   9301.12   1.0   Updated comments. (CSB)
  61. }
  62.  
  63. {$define USE_EXTTEXTOUT}
  64.  
  65. {-- Interface Section ---------------------------------------------------}
  66.  
  67. {$R-,S-}
  68.  
  69. interface
  70.  
  71. uses
  72.   WinTypes,
  73.   OWindows;
  74.  
  75. const
  76.   ibs_HorzCaption = $00004000;
  77.   ibs_VertCaption = $00008000;
  78.  
  79. function ibDefWindowProc(HWin   : hwnd;
  80.                          wMsg,
  81.                          wParam : word;
  82.                          lParam : longint) : longint;
  83. {
  84.   This function should be called instead of DefWindowProc() for windows
  85.   that want to have itsybitsy captions.
  86. }
  87.  
  88. procedure ibAdjustWindowRect(    HWin : hwnd;
  89.                              var lprc : TRect);
  90. {
  91.   Does the same thing as the USER function AdjustWindowRect(), but knows
  92.   about itsybitsy windows.  AdjustWindowRect() is bogus it appears.
  93. }
  94.  
  95. type
  96.   PItsyBitsWindow = ^TItsyBitsWindow;
  97.   TItsyBitsWindow = object(TWindow)
  98.     constructor Init(aParent: PWindowsObject; aTitle: PChar; ibs_Style : longint);
  99.     procedure DefWndProc(var Msg : TMessage); virtual;
  100.     function GetClassName : pchar; virtual;
  101.   end;
  102.  
  103. {-- Implementation Section ----------------------------------------------}
  104.  
  105. implementation
  106.  
  107. uses
  108.   WinProcs,
  109.   Win31;
  110.  
  111. const
  112.               {  BBGGRR}
  113.   RGBLtGray = $00C0C0C0;
  114.   RGBGray   = $00808080;
  115.   RGBBlack  = $00000000;
  116.   RGBWhite  = $00FFFFFF;
  117.  
  118. var
  119.   gcCaption : word;
  120.   fWin31    : bool;
  121.  
  122. {-- TItsyBits Methods ---------------------------------------------------}
  123.  
  124. constructor TItsyBitsWindow.Init;
  125. {
  126.   Overrides TWindow.Init.  Attr.Style is set to (ws_ThickFrame or
  127.   ws_Border or ws_Popup or ws_SysMenu or ws_Visible).  Attr.Style also
  128.   includes the ibs_Style bit, which determines what type of caption this
  129.   ItsyBits window will have.  The allowable values are:
  130.  
  131.     ibs_Style        Meaning
  132.     -----            -------
  133.     ibs_VertCaption  Give the window a vertical caption.
  134.     ibs_HorzCaption  Give the window a horizontal caption.
  135.  
  136.   If an invalid ibs_Style bit is specified, the default will be
  137.   ibs_HorzCaption.
  138. }
  139.   begin
  140.     inherited Init(aParent,aTitle);
  141.     if (ibs_Style <> ibs_HorzCaption) and (ibs_Style <> ibs_VertCaption) then
  142.       ibs_Style := ibs_HorzCaption;
  143.     with Attr do begin
  144.       Style :=
  145.         ibs_Style or
  146.         ws_ThickFrame or
  147.         ws_Border or
  148.         ws_Popup or
  149.         ws_SysMenu or
  150.         ws_Visible;
  151.     end;
  152.   end { TItsyBitsWindow.Init };
  153.  
  154. procedure TItsyBitsWindow.DefWndProc;
  155. {
  156.   Overrides TWindow.DefWndProc.  Calls ibDefWindowProc for certain
  157.   messages.  Other messages are passed on to DefWndProc.
  158.  
  159.   If you add any more message handling capabilities to ibDefWindowProc,
  160.   you must also update this method.
  161. }
  162.   begin
  163.     case Msg.Message of
  164.       wm_SysChar,
  165.       wm_SysKeyDown,
  166.       wm_SysKeyUp,
  167.       wm_KeyDown,
  168.       wm_KeyUp,
  169.       wm_GetMinMaxInfo,
  170.       wm_Command,
  171.       wm_NCCreate,
  172.       wm_NCCalcSize,
  173.       wm_NCHitTest,
  174.       wm_NCLButtonDblClk,
  175.       wm_NCLButtonDown,
  176.       wm_NCActivate,
  177.       wm_NCPaint : begin
  178.         with Msg do
  179.           Result := ibDefWindowProc(Receiver,Message,wParam,lParam);
  180.       end
  181.     else
  182.       inherited DefWndProc(Msg);
  183.     end;
  184.   end { TItsyBitsWindow.DefWndProc };
  185.  
  186. function TItsyBitsWindow.GetClassName;
  187. {
  188.   Returns a class name of 'ItsyWnd';
  189. }
  190.   begin
  191.     GetClassName := 'ItsyWnd';
  192.   end { TItsyBitsWindow.GetClassName };
  193.  
  194. {-- Local Functions -----------------------------------------------------}
  195.  
  196. function CaptionXY : integer;
  197.   begin
  198.     CaptionXY := GetSystemMetrics(sm_CYCaption) div 2 + 4;
  199.   end { CaptionXY };
  200.  
  201. function GetStyle(HWin : hwnd) : word;
  202.   begin
  203.     GetStyle := LoWord(GetWindowLong(HWin,gwl_Style));
  204.   end { GetStyle };
  205.  
  206. function HasCaption(HWin : hwnd) : boolean;
  207.   begin
  208.     HasCaption := ((GetStyle(HWin) and ibs_VertCaption) <> 0) or
  209.                   ((GetStyle(HWin) and ibs_HorzCaption) <> 0);
  210.   end { HasCaption };
  211.  
  212. function TestWinStyle(HWin       : hwnd;
  213.                       dwStyleBit : longint) : bool;
  214.   begin
  215.     TestWinStyle := (GetWindowLong(HWin,gwl_Style) and dwStyleBit) <> 0;
  216.   end { TestWinStyle };
  217.  
  218. {$ifdef USE_EXTTEXTOUT}
  219. procedure DrawFastRect(    DC   : hdc;
  220.                        var lprc : TRect);
  221.   begin
  222.     ExtTextOut(DC,0,0,eto_Opaque,@lprc,nil,0,nil);
  223.   end { DrawFastRect };
  224. {$else}
  225. procedure DrawFastRect(    DC   : hdc;
  226.                        var lprc : TRect);
  227.   var
  228.     hbr : HBrush;
  229.   begin
  230.     hbr := CreateSolidBrush(GetBkColor(DC));
  231.     hbr := SelectObject(DC,hbr);
  232.     PatBlt(DC,lprc.left,lprc.top,lprc.right - lprc.left,lprc.bottom - lprc.top,PatCopy);
  233.     hbr := SelectObject(DC,hbr);
  234.     DeleteObject(hbr);
  235.   end;
  236. {$endif}
  237.  
  238. function ibGetCaptionRect(    HWin : hwnd;
  239.                           var lprc : TRect) : bool;
  240. {
  241.   Calcluales the rectangle of the mini-caption in screen coords.
  242. }
  243.   begin
  244.     if not HasCaption(HWin) then begin
  245.       SetRectEmpty(lprc);
  246.       ibGetCaptionRect := false;
  247.       exit;
  248.     end;
  249.     GetWindowRect(HWin,lprc);
  250.     {
  251.       The window might have other non-client components like borders.
  252.     }
  253.     if TestWinStyle(HWin,ws_ThickFrame) then
  254.       begin
  255.         inc(lprc.left,GetSystemMetrics(sm_CXFrame));
  256.         inc(lprc.top,GetSystemMetrics(sm_CYFrame));
  257.         dec(lprc.right,GetSystemMetrics(sm_CXFrame));
  258.         dec(lprc.bottom,GetSystemMetrics(sm_CYFrame));
  259.       end
  260.     else
  261.       if TestWinStyle(HWin,ws_Border) then begin
  262.         inc(lprc.left,GetSystemMetrics(sm_CXBorder));
  263.         inc(lprc.top,GetSystemMetrics(sm_CYBorder));
  264.         dec(lprc.right,GetSystemMetrics(sm_CXBorder));
  265.         d